Attribute VB_Name = "SharedIconRes"
'====================================================================================
'IconRes - Apply a 32-Bit icon to a form (to replace the ugly 16-colour VB one)
'====================================================================================
'NOTE: Please be careful when editing this page. This same module is used both in _
       the game and the level editor
       
'This module is here because I'm anal-retentive. VB6 does not support 32-bit colour _
 icons. Also the form icon can only be 16-colours. No icon is included in this _
 project, but instead compiled in using ResHacker. See 'Includes' folder

'The SetIcon function in this module uses the API to apply the 32-Bit Icon at _
 runtime so that the Form Icon, the Alt-Tab Icon and the Taskbar Button Icon are _
 all 32-Bit. I've also included a 128x128 icon for those who use YzDock/AquaDock _
 and a 256x256 icon for Vista

'All credit to VBAccelerator for this code: _
   http://vbaccelerator.com/home/VB/Tips/Setting_the_App_Icon_Correctly/article.asp
'------------------------------------------------------------------------------------
Option Explicit

Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Private Const SM_CXICON = 11
Private Const SM_CYICON = 12
Private Const SM_CXSMICON = 49
Private Const SM_CYSMICON = 50
   
Private Declare Function LoadImageAsString Lib "user32" Alias "LoadImageA" (ByVal hInst As Long, ByVal lpsz As String, ByVal uType As Long, ByVal cxDesired As Long, ByVal cyDesired As Long, ByVal fuLoad As Long) As Long
Private Const LR_DEFAULTCOLOR = &H0
Private Const LR_MONOCHROME = &H1
Private Const LR_COLOR = &H2
Private Const LR_COPYRETURNORG = &H4
Private Const LR_COPYDELETEORG = &H8
Private Const LR_LOADFROMFILE = &H10
Private Const LR_LOADTRANSPARENT = &H20
Private Const LR_DEFAULTSIZE = &H40
Private Const LR_VGACOLOR = &H80
Private Const LR_LOADMAP3DCOLORS = &H1000
Private Const LR_CREATEDIBSECTION = &H2000
Private Const LR_COPYFROMRESOURCE = &H4000
Private Const LR_SHARED = &H8000&

Private Const IMAGE_ICON = 1

Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Const WM_SETICON = &H80

Private Const ICON_SMALL = 0
Private Const ICON_BIG = 1

Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Private Const GW_OWNER = 4

'====================================================================================
'SetIcon: Apply a 32-Bit icon to a form
'====================================================================================
Public Sub SetIcon(ByVal hWnd As Long, ByVal sIconResName As String, Optional ByVal bSetAsAppIcon As Boolean = True)
    'This function has no effect when running in the IDE. If so, leave now
    If SharedStartUp.InIDE = True Then Exit Sub
    
    Dim lhWndTop As Long
    Dim lhWnd As Long
    Dim cx As Long
    Dim cy As Long
    Dim hIconLarge As Long
    Dim hIconSmall As Long
       
    If (bSetAsAppIcon) Then
        'Find VB's hidden parent window:
        lhWnd = hWnd
        lhWndTop = lhWnd
        Do While Not (lhWnd = 0)
            lhWnd = GetWindow(lhWnd, GW_OWNER)
            If Not (lhWnd = 0) Then
                lhWndTop = lhWnd
            End If
        Loop
    End If
    
    cx = GetSystemMetrics(SM_CXICON)
    cy = GetSystemMetrics(SM_CYICON)
    hIconLarge = LoadImageAsString(VB.App.hInstance, sIconResName, IMAGE_ICON, cx, cy, LR_SHARED)
    If (bSetAsAppIcon) Then
       SendMessageLong lhWndTop, WM_SETICON, ICON_BIG, hIconLarge
    End If
    SendMessageLong hWnd, WM_SETICON, ICON_BIG, hIconLarge
    
    cx = GetSystemMetrics(SM_CXSMICON)
    cy = GetSystemMetrics(SM_CYSMICON)
    hIconSmall = LoadImageAsString(VB.App.hInstance, sIconResName, IMAGE_ICON, cx, cy, LR_SHARED)
    If (bSetAsAppIcon) Then
       SendMessageLong lhWndTop, WM_SETICON, ICON_SMALL, hIconSmall
    End If
    SendMessageLong hWnd, WM_SETICON, ICON_SMALL, hIconSmall
End Sub

'=== END ============================================================================
'This work is licenced under the Creative Commons Attribution 2.5 License
